home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 4 / Precision Software Applications Silver Collection Volume 4 (1993).iso / stats / fdplot92.exe / T3.BAS < prev    next >
BASIC Source File  |  1992-08-15  |  6KB  |  179 lines
  1. 2000 REM Define graph position/orientation
  2. 2005 IF NF$="Y" THEN PRINT:INPUT" X min, X max for functions ";TMIN,TMAX
  3. 2050 PRINT" Rectangular or sqare plot (R/S)? _";
  4. 2051 GOSUB 8000
  5. 2060 IF A$<>"R" AND A$<>"S" THEN 2051 ELSE PRINT A$
  6. 2070 IF A$="S" THEN XLN%=YLN%*(1+INT(200/SZY%))
  7. 2090 PRINT:PRINT" SCALES: Regular, Grid or None? (R/G/N) _";
  8. 2091 GOSUB 8000
  9. 2095 IF A$<>"R" AND A$<>"G" AND A$<>"N" THEN 2091 ELSE PRINT A$
  10. 2100 SC$=A$
  11. 2105 IF SC$="N" THEN GOTO 2117
  12. 2110 PRINT:INPUT" Enter X-title (max 20 characters) or ─┘ ",XTITLE$
  13. 2115 INPUT" Enter Y-title (max 20 characters) or ─┘ ",YTITLE$
  14. 2117 IF NF$="Y" THEN INPUT " Function detail? (-1 to +1, or ─┘) ";DTL
  15. 2120 CLS
  16. 2125 REM PLOT X TITLE
  17. 2130 IF LEN(XTITLE$)=0 THEN 2150
  18. 2142   LOCATE (25+YADD%),40
  19. 2145   PRINT XTITLE$;
  20. 2150 REM END XTITLE
  21. 2155 REM PLOT Y TITLE
  22. 2160   IF LEN(YTITLE$)=0 THEN 2185
  23. 2175   LOCATE 1,2
  24. 2180   PRINT YTITLE$;
  25. 2185 REM END YTITLE
  26. 2190 RETURN
  27. 3000 REM Functions/data-sets retrieval, plot axes and scales
  28. 3050 REM Retreive data sets
  29. 3055 IF ND$="N" THEN 3115
  30. 3065     FM$="PLOTD"
  31. 3070     OPEN "I",#1,FM$
  32. 3075     INPUT #1,DTSN
  33. 3085     FOR J=1 TO DTSN
  34. 3090         INPUT #1,DATX(J),DATY(J)
  35. 3095     NEXT J
  36. 3100     INPUT #1,CORL$
  37. 3105     CLOSE #1
  38. 3115 REM FIND DATA SET MAX/MIN
  39. 3120 IF ND$="N" THEN 3180
  40. 3125   TEMP=DATX(1):TEMP2=DATY(1)
  41. 3130   XMIN=TEMP:XMAX=TEMP
  42. 3135   YMIN=TEMP2:YMAX=TEMP2
  43. 3145     FOR J=1 TO DTSN
  44. 3150       IF DATX(J)<XMIN THEN XMIN=DATX(J)
  45. 3155       IF DATX(J)>XMAX THEN XMAX=DATX(J)
  46. 3160       IF DATY(J)<YMIN THEN YMIN=DATY(J)
  47. 3165       IF DATY(J)>YMAX THEN YMAX=DATY(J)
  48. 3170     NEXT J
  49. 3180 REM END DATA MAX/MIN
  50. 3185 REM FIND FUNCTIONS MAX/MIN
  51. 3190 IF NF$="N" THEN 3265
  52. 3200   IF ABS(DTL) > .88 THEN DTL=SGN(DTL)*.88
  53. 3203   DTL=SGN(DTL)*SQR(ABS(DTL))
  54. 3205   TINC=(TMAX-TMIN)/50/(1.1+DTL)*(1.1-DTL) 'Try 50 divisions for functions
  55. 3210   T=TMIN:X=T:GOSUB 1100
  56. 3215   IF ND$="N" THEN YMIN=Y:YMAX=Y:XMIN=X:XMAX=X
  57. 3220   FOR T=TMIN TO TMAX STEP TINC
  58. 3225       X=T
  59. 3235       GOSUB 1100
  60. 3240       IF Y<YMIN THEN YMIN=Y
  61. 3245       IF Y>YMAX THEN YMAX=Y
  62. 3250       IF X<XMIN THEN XMIN=X
  63. 3255       IF X>XMAX THEN XMAX=X
  64. 3260   NEXT T
  65. 3265 REM END FUNCT TEST
  66. 3270 REM DRAW SCALES AND AXES
  67. 3280 REM SELECT Y SCALES
  68. 3285 A=LOG(YMAX-YMIN)*.434294:IF A<0 THEN A1=A+ABS(INT(A)) ELSE A1=A-INT(A)
  69. 3290 A2=10^(A-A1):YF=A2 '
  70. 3295 A3=INT(YMIN/A2) '
  71. 3300 A4=A3*A2 '
  72. 3305 SY=INT(YMAX/A2+.95)-A3 '
  73. 3310 NTC%=.007*SZY%
  74. 3315 IF SY<5 THEN RN=.5 ELSE RN=1 '
  75. 3317 IF SY=1 THEN RN=.2
  76. 3320 IF SC$="N" THEN 3400
  77. 3325 FOR RI=0 TO SY STEP RN
  78. 3330 REM PRINT SCALE #'S
  79. 3335 XPP=-.041*SZX%:YPP=RI*YLN%/SY-NTC% '
  80. 3340 GOSUB 6000
  81. 3350 YTITLE$=STR$(A3+RI)
  82. 3355 PRINT YTITLE$
  83. 3360 REM
  84. 3365 MOVE$="B"
  85. 3370 IF SC$="R" THEN XPP=NTC%*4 ELSE XPP=XLN%
  86. 3372 YPP=YPP+NTC%:GOSUB 5010
  87. 3375 XPP=0:GOSUB 5010
  88. 3380 IF RI=SY THEN 3390
  89. 3385   YPP=(RI+RN)*YLN%/SY:GOSUB 5010
  90. 3390 NEXT RI
  91. 3400 REM SELECT X SCALES
  92. 3405 B=LOG(XMAX-XMIN)*.434294:IF B<0 THEN B1=B+ABS(INT(B)) ELSE B1=B-INT(B)
  93. 3410 B2=10^(B-B1):XF=B2
  94. 3415 B3=INT(XMIN/B2)
  95. 3420 B4=B3*B2
  96. 3425 SX=INT(XMAX/B2+.95)-B3
  97. 3430 IF SX<5 THEN RN=.5 ELSE RN=1
  98. 3433 IF SX=1 THEN RN=.2
  99. 3435 TEMPX=XLN%/SX/XF:TEMPY=YLN%/SY/YF
  100. 3440 IF SC$="N" THEN 3515
  101. 3445 FOR RI=0 TO SX STEP RN
  102. 3450 REM
  103. 3455 YPP=-5*NTC%:XPP=RI*XLN%/SX-2*NTC% 
  104. 3460 GOSUB 6000 
  105. 3465 XTITLE$=STR$(B3+RI)
  106. 3466 IF (B3+RI>=0) THEN XTITLE$=MID$(STR$(B3+RI),2)
  107. 3470 PRINT XTITLE$;
  108. 3475 REM
  109. 3472 MOVE$="B"
  110. 3480 IF SC$="R" THEN YPP=4*NTC% ELSE YPP=YLN%
  111. 3485 XPP=XPP+2*NTC%:GOSUB 5010
  112. 3490 YPP=0:GOSUB 5010 ' write notch
  113. 3495 IF RI=SX THEN 3510
  114. 3500   XPP=(RI+RN)*XLN%/SX:GOSUB 5010
  115. 3510 NEXT RI
  116. 3515 REM
  117. 3520 REM
  118. 3525 IF SC$="N" THEN RETURN
  119. 3530 XTITLE$="(Scale: X/"+MID$(STR$(XF),2)+", Y/"+MID$(STR$(YF),2)+")"
  120. 3535 LOCATE (25+YADD%),5
  121. 3540 PRINT XTITLE$;
  122. 3545 RETURN
  123. 4000 IF NF$="N" THEN 4110
  124. 4005 REM
  125. 4010 STP=.02*SZX%/(1.1+DTL)*(1.1-DTL)
  126. 4015 T=TMIN:GOSUB 1100
  127. 4020 GOSUB 5040
  128. 4025 X1=X%:Y1=Y%:TINCTMP=TINC
  129. 4028 T=TMIN+TINC:GOSUB 1100
  130. 4030   GOSUB 5040
  131. 4032   X2=X%:Y2=Y%:TS1=SQR((X1-X2)^2+(Y1-Y2)^2)
  132. 4033   IF TS1<.5 THEN TINC=TINC+TINCTMP:GOTO 4028
  133. 4035   IF TS1>STP THEN TINC=.9*TINC: GOTO 4028 
  134. 4040 REM PLOTF
  135. 4050   T=TMIN:GOSUB 1100
  136. 4055   CLR$="C"+STR$(240) 'curve colour
  137. 4056   DRAW CLR$
  138. 4060   MOVE$="B":GOSUB 5000
  139. 4075   FOR T=TMIN+TINC TO TMAX STEP TINC
  140. 4080     GOSUB 1100
  141. 4085     GOSUB 5000
  142. 4095   NEXT T 
  143. 4100 REM
  144. 4110 IF ND$="N" THEN 4210' plot data sets
  145. 4112 DRAW "C255"
  146. 4125   FOR J=1 TO DTSN
  147. 4130     X=DATX(J):Y=DATY(J):MOVE$="B":GOSUB 5000
  148. 4140     GOSUB 7100
  149. 4205   NEXT J
  150. 4210 REM 
  151. 4215 WHILE INKEY$="":WEND 'after plot wait for any key to be pressed.
  152. 4220 RETURN                     
  153. 5000 REM normal math coords -> plotter abs coords
  154. 5005 YPP=(Y-A4)*TEMPY:XPP=(X-B4)*TEMPX
  155. 5010 REM translate axes, & plot
  156. 5015 X%=XPP+HT%
  157. 5020 Y%=SZY%-(YPP+KT%)'Note screen y is downward in IBM-PC.
  158. 5025 REM Change coordinates into "plotting" form and send
  159. 5030 MOVE$=MOVE$+"M"+STR$(X%)+","+STR$(Y%)
  160. 5032 DRAW MOVE$
  161. 5035 MOVE$="" : RETURN    'RESET "pen up" to "down"
  162. 5040 REM TRANSL ONLY
  163. 5045 YPP=(Y-A4)*TEMPY:XPP=(X-B4)*TEMPX
  164. 5050 X%=XPP+HT%
  165. 5055 Y%=SZY%-(YPP+KT%):RETURN
  166. 6000 X%=XPP+HT% 'Locate nearest ascii spot
  167. 6010 Y%=SZY%-(YPP+KT%)
  168. 6020 ROW%=(Y%/SZY%*(25+YADD%)+.5):COL%=(X%/SZX%*80+.5)
  169. 6030 LOCATE ROW%,COL% :RETURN
  170. 7100 REM draw data symb1
  171. 7105 A$="BE2;D4;L4;U4;R4"
  172. 7110 DRAW A$
  173. 7199 RETURN
  174. 8000 A$=INKEY$:IF (A$="") GOTO 8000
  175. 8010 IF (ASC(A$)> 96) THEN A$=CHR$(ASC(A$)-32)
  176. 8020 RETURN
  177. 9000 PRINT" ERROR: VMODE selection or Function/data definition."
  178. 9005 PRINT"    Press ─┘ for menu ";: INPUT"",A$: CHAIN "MENU"
  179.